'  ==========================================================================
'  |                                                                        |
'  | SQLitening Procs Suffix A                                              |
'  |                                                                        |
'  ==========================================================================
'
'  ==========>>> General to All Procs
'  Procs will allow you to write your own code which will run at the server
'  accessing SQLite in local mode.  These Procs can talk directly to SQLite 
'  or can go thru SQLitening.  Not using SQLitening could result in a slightly
'  more efficient Proc but is harder to develop.  Procs will also work fine 
'  at the client in local mode. This concept is similar to database procedures 
'  in Oracle and MySQL except here you get to code in Basic (or any language 
'  than can produce a standard DLL) rather that their proprietary language. 
'  Using Procs can greatly improve response time by reducing messages to/from 
'  the server.  You must developing a Proc very carefully because it runs as 
'  part of the service on the server.  If your Proc crashes your service will 
'  also crash.  Your Proc must do proper clean-up.  You must close all open 
'  connections, databases, and  sets before ending/unloading.
'  CAUTION1:  This DLL is running as part of the service on the server so all 
'             sets must be closed/finalized ASAP so locks are released. (don't 
'             return to the caller with open/un-finalized sets)
'  CAUTION2:  This DLL must be thread safe so careful with globals or use
'             Threaded global variables.
'   All Procs that are to be called with slRunProc must be named SQLiteningProc?.Dll 
'   where ? must be a single alpha suffix character of A thru Z.  Each Proc can have 
'   as many entries as required and may be named whatever you would like.  The suffix 
'   and entry name are used in slRunProc.  Each entry must receive the following parms 
'   and returns a Long:  
'              byval rhDab as Dword, _
'              byval rlTcpFileNumber as Long, _
'              blParm1 as Long, _
'              blParm2 as Long, _
'              bsParm3 as String, _
'              bsParm4 as String)Export as Long
'   If the Proc is called by using the load_extension SQLite function then the only 
'   parm is Dab and returs a Long:
'              byval rhDab as Dword
'   If a database is open when the Proc is called then Dab will contain
'   the handle and it can be used to do SQLite calls directly or can be passed 
'   to slOpen so that the previously openned database can inherited by SQLitening.Dll.
'   If Dab is zero then the database must be opened here and then closed before 
'   returning. If running remote then TcpFileNumber will contain the unique number 
'   assigned by the server to this connection or zero if running local.   Note 
'   that the two longs and two strings parms are both received and passed (in and 
'   out).  These are the four parms you will use to communicate with the Proc using
'   slRunProc.  The return value from this function must be zero if all OK or non
'   zero if an error occurs.
' 
'  ==========>>> About this sample Proc
'   This Proc contains the follow three sample entries:
'   Entry 1 ===>>>  
'        Will open and optionally creates a database file called Test.Sld.
'        Creates a table called T1 and then inserts some rows.  It then 
'        selects.  It then returns meaningless parms.  This entry calls
'        SQLite directly for all processing.
'   Entry 2 ===>>>
'       This is an example of how an entry can be called by using the SQLite
'       load_extension function as follows:
'              slExe "Select load_extension('SQLiteningProcsA', 'Entry2')"
'        Using this method rather than slRunProc has use in a database trigger. 
'        Notice that you can not pass parms using load_extension but within the 
'        trigger you could insert a row into a "control" table that contains 
'        the required parm data.
'   CreateFunction ===>>>  
'        This is an example to how to create SQLite custom function.  This Proc 
'        is called by slRunProc.  The creatd functions can then be used in your
'        SQL statements. This library must remain loaded for the functions to be
'        usable.  See slRunProc for keep-loaded details.  
' 
'  ==========================================================================
'  PUBLIC DOMAIN SOFTWARE
'  The author or authors of this code dedicate any and all
'  copyright interest in this code to the public domain.
'  Anyone is free to copy, modify, publish, use, compile,
'  sell, or distribute the original code, either in source
'  code form or as a compiled binary, for any purpose,
'  commercial or non-commercial, and by any means.
'  Fred Meier - July 2010
'  ==========================================================================

#Compile Dll "..\Bin\SQLiteningProcsA.Dll"
#Dim All
' DO NOT Include SQLitening.Inc

'============================<[ Equates ]>=============================
' ==========>>> SQLite
%SQLITE3_OK     =   0   '*/ Successful result */
%SQLITE3_BUSY   =   5   '*/ The database file is locked */
%SQLITE3_ROW    = 100   '*/ sqlite3_step() has another row ready */
%SQLITE3_DONE   = 101   '*/ sqlite3_step() has finished executing */
%SQLITE_OPEN_READONLY = &H00000001
%SQLITE_OPEN_READWRITE = &H00000002
%SQLITE_OPEN_CREATE = &H00000004
%SQLIte_UTF8      = 1
%SQLite_Transient = -1

'=======================<[ SQLite Error Codes ]>=======================
'     0 = Successful result
'     1 = SQL error or missing database
'     2 = Internal logic error in SQLite
'     3 = Access permission denied
'     4 = Callback routine requested an abort
'     5 = The database file is locked
'     6 = A table in the database is locked
'     7 = A malloc() failed
'     8 = Attempt to write a readonly database
'     9 = Operation terminated by sqlite3_interrupt()
'    10 = Some kind of disk I/O error occurred
'    11 = The database disk image is malformed
'    12 = NOT USED. Table or record not found
'    13 = Insertion failed because database is full
'    14 = Unable to open the database file
'    15 = NOT USED. Database lock protocol error
'    16 = Database is empty
'    17 = The database schema changed
'    18 = String or BLOB exceeds size limit
'    19 = Abort due to constraint violation
'         ' Normally caused by trying to add a non unique key
'         ' to an index during an Insert or Update.
'    20 = Data type mismatch
'    21 = Library used incorrectly
'    22 = Uses OS features not supported on host
'    23 = Authorization denied
'    24 = Auxiliary database format error
'    25 = 2nd parameter to sqlite3_bind out of range
'    26 = File opened that is not a database file
'   100 = sqlite_step() has another row ready
'   101 = sqlite_step() has finished executing

'=========================<[ SQLite Declares ]>=========================
Declare Function sqlite3_bind_blob cdecl lib "sqlite3.dll" alias "sqlite3_bind_blob" (byval rhSet as Dword, byval rlPos as Long, byval rsData as Dword, byval rlLen as Long, byval rhZero as Dword) as Long
Declare Function sqlite3_bind_null cdecl lib "sqlite3.dll" alias "sqlite3_bind_null" (byval rhSet as Dword, byval rlPos as Long) as Long
Declare Function sqlite3_bind_text cdecl lib "sqlite3.dll" alias "sqlite3_bind_text" (byval rhSet as Dword, byval rlPos as Long, byval rsData as Dword, byval rlLen as Long, byval rhZero as Dword) as Long
Declare Sub      sqlite3_busy_timeout cdecl lib "sqlite3.dll" alias "sqlite3_busy_timeout" (byval rhDab as Dword, byval rlWaitMS as Long)
Declare Function sqlite3_changes cdecl lib "sqlite3.dll" alias "sqlite3_changes" (byval rhDab as Dword) as Long
Declare Function sqlite3_close cdecl lib "sqlite3.dll" alias "sqlite3_close" (byval rhDab as Dword) as Long
Declare Function sqlite3_column_blob cdecl lib "sqlite3.dll" alias "sqlite3_column_blob" (byval rhSet as Dword, byval rlCol as Long) as Dword
Declare Function sqlite3_column_bytes cdecl lib "sqlite3.dll" alias "sqlite3_column_bytes" (byval rhSet as Dword, byval rlCol as Long) as Long
Declare Function sqlite3_column_count cdecl lib "sqlite3.dll" alias "sqlite3_column_count" (byval rhSet as Dword) as Long
Declare Function sqlite3_column_name cdecl lib "sqlite3.dll" alias "sqlite3_column_name" (byval rhSet as Dword, byval rlCol as Long) as Long
Declare Function sqlite3_column_type cdecl lib "sqlite3.dll" alias "sqlite3_column_type" (byval rhSet as Dword, byval rlCol as Long) as Long
Declare Function sqlite3_create_function cdecl lib "sqlite3.dll" alias "sqlite3_create_function" (byval rhDab as Dword, zName as Asciiz, byval nArg as Long, byval eTextRep as Long, _
                                                                                                  byval pUserData as Dword, byval pFunc as Dword, byval pStep as Dword, byval pFinal as Dword) as Long
Declare Function sqlite3_errcode cdecl lib "sqlite3.dll" alias "sqlite3_errcode" (byval rhDab as Dword) as Long
Declare Function sqlite3_errmsg cdecl lib "sqlite3.dll" alias "sqlite3_errmsg" (byval rhDab as Dword) as Long
Declare Function sqlite3_exec cdecl lib "sqlite3.dll" alias "sqlite3_exec" (byval rhDab as Dword, byval rspStatements as Dword, byval rhZero as Dword, byval rhZero as Dword, byval rhZero as Dword) as Long
Declare Function sqlite3_finalize cdecl lib "sqlite3.dll" alias "sqlite3_finalize" (byval rhSet as Dword) as Long
Declare Function sqlite3_last_insert_rowid cdecl lib "sqlite3.dll" alias "sqlite3_last_insert_rowid" (byval rhDab as Dword) as Quad
Declare Function sqlite3_open_v2 cdecl lib "sqlite3.dll" alias "sqlite3_open_v2" (rzFilename as Asciiz, wrhDab as Dword, byval rlFlags as Long, byval rlNull as Long) as Long
Declare Function sqlite3_prepare_v2 cdecl lib "sqlite3.dll" alias "sqlite3_prepare_v2" (byval rhDab as Dword, byval rspStatement as Dword, byval rlLen as Long, ppVMM as Dword, byval pzTail as Asciiz ptr) as Long
Declare Function sqlite3_reset cdecl lib "sqlite3.dll" alias "sqlite3_reset" (byval rhSet as Dword) as Long
Declare Sub      sqlite3_result_blob cdecl lib "sqlite3.dll" alias "sqlite3_result_blob" (byval sqlite3_context as Dword, byval pzText as Dword, byval nBytes as Long, byval Dword)
Declare Sub      sqlite3_result_text cdecl lib "sqlite3.dll" alias "sqlite3_result_text" (byval sqlite3_context as Dword, byval pzText as Dword, byval nBytes as Long, byval Dword)
Declare Function sqlite3_threadsafe cdecl lib "sqlite3.dll" alias "sqlite3_threadsafe" () as Long
Declare Function sqlite3_step cdecl lib "sqlite3.dll" alias "sqlite3_step" (byval rhSet as Dword) as Long
Declare Function sqlite3_total_changes cdecl lib "sqlite3.dll" alias "sqlite3_total_changes" (byval rhDab as Dword) as Long
Declare Sub      sqlite3_thread_cleanup cdecl lib "sqlite3.dll" alias "sqlite3_thread_cleanup"
Declare Function sqlite3_user_data cdecl lib "sqlite3.dll" alias "sqlite3_user_data" (byval sqlite3_context as Dword) as Dword
Declare Function sqlite3_value_text cdecl lib "sqlite3.dll" alias "sqlite3_value_text" (byval sqlite3_value as Dword) as Dword
Declare Function sqlite3_value_int cdecl lib "sqlite3.dll" alias "sqlite3_value_int" (byval sqlite3_value as Dword) as Dword

'=============================<[ Macros ]>=============================
' ==========>>> Open
Macro Function slmOpen(rsFileName, rlFlags, whDab)
   Macrotemp llRC
   Local llRC as Long
   llRC = sqlite3_open_v2(rsFileName, whDab, rlFlags or iif&(isfalse (rlFlags and %SQLITE_OPEN_READONLY), %SQLITE_OPEN_READWRITE, 0), 0)
   if isfalse llRC then
      sqlite3_busy_timeout whDab, 10000
   end if
End Macro = llRC

' ==========>>> Prep
Macro Function slmPrep(rhDab, rsStatement, whSet)
   Macrotemp lsA
   Local lsA as String
   lsA = rsStatement
End Macro = sqlite3_prepare_v2(rhDab, strptr(lsA), len(lsA), whSet, 0)

' ==========>>> Step
Macro Function slmStep(rhSet)
End Macro = sqlite3_step(rhSet)

' ==========>>> Finalize
Macro Function slmFinalize(rhSet)
End Macro = sqlite3_finalize(rhSet)

' ==========>>> Finalize No Return Code
MACRO slmFinalizeNoRC(rhSet) = sqlite3_finalize(rhSet)

' ==========>>> Exe
Macro Function slmExe(rhDab, rsStatement)
   Macrotemp lsA
   Local lsA as String
   lsA = rsStatement
End Macro = sqlite3_exec(rhDab, strptr(lsA), 0, 0, 0)

' ==========>>> Bind Blob
Macro Function slmBindBlob(rhSet, rlIndex, rsData)
   Macrotemp lsA
   Local lsA as String
   lsA = rsData
End Macro = sqlite3_bind_blob(rhSet, rlIndex, strptr(lsA), len(lsA), 0)

' ==========>>> Bind Text
Macro Function slmBindText(rhSet, rlIndex, rsData)
   Macrotemp lsA
   Local lsA as String
   lsA = rsData
End Macro = sqlite3_bind_text(rhSet, rlIndex, strptr(lsA), len(lsA), 0)

' ==========>>> Close
Macro Function slmClose(rhDab)
End Macro = sqlite3_close(rhDab)

' ==========>>> Close No Return Code
MACRO slmCloseNoRC(rhDab) = sqlite3_close(rhDab)

' ==========>>> Field Get
Macro Function slmF(rhSet, rlField)
End Macro = peek$(sqlite3_column_blob(rhSet, rlField - 1),  sqlite3_column_bytes(rhSet, rlField - 1))

' ==========>>> Get Field Type
Macro Function slmGetFieldType(rhSet, rlField)
'     Integer=1, Float=2, Text=3, BLOB=4, Null=5
End Macro = sqlite3_column_type(rhSet, rlField - 1)

' ==========>>> Get Insert ID
Macro Function slmGetInsertID(rhDab)
End Macro = sqlite3_last_insert_rowid (rhDab)

' ==========>>> Set Busy Timeout
MACRO slmSetBusyTimeout(rhDab, rlMilliSeconds ) = sqlite3_busy_timeout rhDab, rlMilliSeconds

' ==========>>> Get Error
Macro Function slmGetError(rhDab)
	Macrotemp lzpError
   Local lzpError as Asciiz Ptr
   lzpError= sqlite3_errmsg(rhDab)
End Macro = @lzpError

'============================<[ Globals ]>=============================
' MUST BE THREAD SAFE ---  USE CriticalSection CODE TO UPDATE  GLOBALS !!!!

'============================<[ Entry 1 ]>=============================
Function Entry1 alias "Entry1" (byval rhDab as Dword, _
                                byval rlTcpFileNumber as Long, _
                                blParm1 as Long, _
                                blParm2 as Long, _
                                bsParm3 as String, _
                                bsParm4 as String)Export as Long
'   This sample open and optionally creates a database file called Test.Sld.
'   Creates a table called T1 and then inserts some rows.  It then selects
'   those rows.  It then returns meaningless parms.  This entry calls SQLite 
'   directly for all processing.

   Local llRC as Long
   Local lhDab as Dword
   Local lhSet as Dword
   Local lsField1Data, lsField2Data as String

   chdir exe.path$

   ' Open database
   100 llRC = slmOpen("Test.Sld", %SQLITE_OPEN_CREATE, lhDab)
   if llRC then goto ErrorExit

   ' Create table if not there
   200 llRC = slmExe(lhDab, "Create table if not exists T1 (F1,F2)")
   if llRC then goto ErrorExit

   ' Insert some records
   300 llRC = slmExe(lhDab, "Insert into T1 values ('Hello666',34562)")
   if llRC then goto ErrorExit
   310 llRC = slmExe(lhDab, "Insert into T1 values ('666',2)")
   if llRC then goto ErrorExit

   ' Insert a record using bind
   ' Prep
   400 llRC = slmPrep(lhDab, "Insert into T1 values (?, ?)", lhSet)
   if llRC then goto ErrorExit
   ' Bind 1
   401 llRC = slmBindBlob(lhSet, 1, chr$(&H12) & mkl$(123456) & "Data1111")
   if llRC then goto ErrorExit
   ' Bind 2
   402 llRC = slmBindText(lhSet, 2, chr$(&H12) & mkl$(123456) & "Data22222")
   if llRC then goto ErrorExit
   ' Step
   403 llRC = slmStep(lhSet)
   if llRC <> %SQLITE3_DONE then goto ErrorExit
   ' Finalize
   404 llRC = slmFinalize(lhSet)
   if llRC then goto ErrorExit

   ' Prep the select statement
   500 llRC = slmPrep(lhDab, "Select * from T1", lhSet)
   if llRC then goto ErrorExit

   ' Step thru the returning records
   do
      llRC = slmStep(lhSet)
      if llRC = %SQLITE3_DONE then exit do
      if llRC <> %SQLITE3_ROW then goto ErrorExit

      ' Get the field data
      lsField1Data = slmF(lhSet, 1)
      lsField2Data = slmF(lhSet, 2)

   loop

   'Finalize/close recordset
   600 llRC = slmFinalize(lhSet)
   if llRC then goto ErrorExit

   ' Close database
   700 llRC = slmClose(lhDab)
   if llRC then goto ErrorExit

   ' Return phoney parms
   blParm1 = 88
   blParm2 = 99
   bsParm3 = "NewParm3"
   bsParm4 = "NewParm4"

   ' Return OK
   exit function

ErrorExit:
   bsParm3 = slmGetError(lhDab)           ' Get the error description and return it
   slmFinalizeNoRC(lhSet)                 ' Close set in case it was open
   slmCloseNoRC(lhDab)                    ' Close database in case it was open
   error 151                              ' Trigger error so erl will have line number
   blParm1 = erl                          ' Return error line number
   function = llRC                        ' Set return code

End Function

'============================<[ Entry 2 ]>=============================
Function Entry2 alias "Entry2" (byval rhDab as Dword)Export as long

'   This is an example of how an entry can be called by using the SQLite
'   load_extension function as follows:
'        slExe "Select load_extension('SQLiteningProcsA', 'Entry2')"
'   There will always be an open database handle passed in Dab. The return 
'   value from this function should always be zero.  A non zero value will 
'   cause a SQLite error 1 "error during initializion" to occur. Using this 
'   method rather than slRunProc has use in a database trigger. Notice that 
'   you can not pass parms using load_extension but within the trigger you 
'   could insert a row into a "control" table that contains the required 
'   parm data.

   Local llRC as Long
   Local lhSet as Dword

'   This sample does a select of the last insterted row in a table called T1

   llRC = slmPrep(rhDab, "Select rowid,* from T1 where rowid = (select max(rowid) from T1)", lhSet)
   do
      llRC = slmStep(lhSet)
      if llRC = %SQLITE3_DONE then exit do

   loop
   llRC = slmFinalize(lhSet)

End Function

'========================<[ Create Function ]>=========================
Function CreateFunction alias "CreateFunction" (byval rhDab as Dword, _
                                byval rlTcpFileNumber as Long, _
                                blParm1 as Long, _
                                blParm2 as Long, _
                                bsParm3 as String, _
                                bsParm4 as String)Export as Long

'   This is a sample proc which can be called by slRunProc which will create 
'   SQLite custom functions.  This example creates two custom functions 
'   (MyF0 and MyF2).  MyF0 accepts no parms while MyF2 requies two parms.
'   This library must remain loaded. See slRunProc for details.  

   Local lzA as asciz * 10

   ' Must have a Dab
   if isfalse rhDab then function = -7 : exit function

   ' Create custom SQLite function called MyF0
   lzA = "MyF0"
   function = sqlite3_create_function(rhDab, lzA, 0, %SQLIte_UTF8, rhDab, codeptr(MyF0), 0, 0)

   ' Create custom SQLite function called MyF2
   lzA = "MyF2"
   function = sqlite3_create_function(rhDab, lzA, 2, %SQLIte_UTF8, rhDab, codeptr(MyF2), 0, 0)

End Function

' ==========>>> SQLite Custom Function MyF0 CallBack
' This expects 0 parms.
Sub MyF0 cdecl(byval rhContext as Dword, byval rlParmCount as Long, byval rhpParms as Dword ptr)

   Local llRC as Long
   Local lhDab as Dword
   Local lhSet as Dword
   Local lsA as String

   lhDab = sqlite3_user_data(rhContext)
   lsA = "This is a test====="

   ' Insert some records
   300 llRC = slmExe(lhDab, "Insert into T1 values ('Hello666',34562)")
   if llRC then goto ErrorExit
   310 llRC = slmExe(lhDab, "Insert into T1 values ('666',2)")
   if llRC then goto ErrorExit

   ' Insert a record using bind
   ' Prep
   400 llRC = slmPrep(lhDab, "Insert into T1 values (?, ?)", lhSet)
   if llRC then goto ErrorExit
   ' Bind 1
   401 llRC = slmBindBlob(lhSet, 1, "Data1111")
   if llRC then goto ErrorExit
   ' Bind 2
   402 llRC = slmBindText(lhSet, 2, mkl$(123456) & "Data22222")
   if llRC then goto ErrorExit
   ' Step
   403 llRC = slmStep(lhSet)
   if llRC <> %SQLITE3_DONE then goto ErrorExit
   ' Finalize
   404 llRC = slmFinalize(lhSet)
   if llRC then goto ErrorExit

   ' Prep the select statement
   500 llRC = slmPrep(lhDab, "Select * from T1", lhSet)
   if llRC then goto ErrorExit

   ' Step thru the returning records
   do
      llRC = slmStep(lhSet)
      if llRC = %SQLITE3_DONE then exit do
      if llRC <> %SQLITE3_ROW then goto ErrorExit

      ' Get the field data
      lsA &= slmF(lhSet, 1)
      lsA &= slmF(lhSet, 2)

   loop

   'Finalize/close recordset
   600 llRC = slmFinalize(lhSet)
   if llRC then goto ErrorExit

   ResultBack:
   sqlite3_result_blob rhContext, byval strptr(lsA), -1, %SQLite_Transient

   ' Exit
   exit sub

ErrorExit:
   lsA = "Had Error " & format$(llRC)
   goto ResultBack

End Sub

' ==========>>> SQLite Custom Function MyF2 CallBack
' This expects 2 parms:  Parm 1 is an integer, Parm 2 is text.
Sub MyF2 cdecl(byval rhContext as Dword, byval rlParmCount as Long, byval rhpParms as Dword ptr)

   Local lhDab as Dword
   Local lsA as String
   Local lspParm2 as Asciz ptr

   lhDab = sqlite3_user_data(rhContext)
   lspParm2 = sqlite3_value_text(@rhpParms[1])
   lsA = "This is a test.  Parm1=" & format$(sqlite3_value_int(@rhpParms[0])) & "   Parm2=" & @lspParm2 & " Dab=" & format$(lhDab) & "  conut=" & format$(rlParmCount)
   sqlite3_result_blob rhContext, byval strptr(lsA), -1, %SQLite_Transient

End Sub



